home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / drawbmp.zip / LOADBMPS.PAS < prev   
Pascal/Delphi Source File  |  1993-04-11  |  3KB  |  124 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo unit                                    }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. {$R-}
  10.  
  11. unit LoadBMPs;
  12.  
  13. interface
  14.  
  15. uses WinProcs, WinTypes, Strings, WinDos;
  16.  
  17. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  18.   var Width, Height: LongInt): hBitMap;
  19.  
  20. implementation
  21.  
  22. function CreateBIPalette(BI: PBitMapInfoHeader): HPalette;
  23. type
  24.   ARGBQuad = Array[1..5000] of TRGBQuad;
  25. var
  26.   RGB: ^ARGBQuad;
  27.   NumColors: Word;
  28.   Pal: PLogPalette;
  29.   hPal: hPalette;
  30.   I: Integer;
  31. begin
  32.   CreateBiPalette := 0;
  33.   RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);
  34.   if BI^.biBitCount<24 then
  35.   begin
  36.     NumColors:= 1 shl BI^.biBitCount;
  37.     if NumColors<>0 then
  38.     begin
  39.       GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));
  40.       Pal^.palNumEntries := NumColors;
  41.       Pal^.palVersion := $300;
  42.       for I := 0 to NumColors-1 do
  43.       begin
  44.     Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;
  45.     Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;
  46.     Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;
  47.     Pal^.palPalEntry[I].peFlags := 0;
  48.       end;
  49.       hPal := CreatePalette(Pal^);
  50.       FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));
  51.       CreateBiPalette := hPal;
  52.     end;
  53.   end;
  54. end;
  55.  
  56. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  57.   var Width, Height: LongInt): hBitMap;
  58. var
  59.   BitMapFileHeader: TBitMapFileHeader;
  60.   DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;
  61.   DIB: PBitMapInfoHeader;
  62.   TempDib: Pointer;
  63.   Bits: Pointer;
  64.   F: File;
  65.   BitMap: hBitMap;
  66.   Handle: Word;
  67.   DC: hDC;
  68.   OldCursor: HCursor;
  69. begin
  70.   Assign(F, Name);
  71.   {$I-}Reset(F, 1);{$I+}
  72.   if IOResult<>0 then
  73.   begin
  74.     LoadBMP := 0;
  75.     Exit;
  76.   end;
  77.   OldCursor := SetCursor(LoadCursor(0, IDC_Wait));
  78.   BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));
  79.   DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;
  80.   ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);
  81.   Handle := GlobalAlloc(GMem_Moveable, ReadSize);
  82.   DIB := GlobalLock(Handle);
  83.   TempReadSize := ReadSize;
  84.   TempDib := Dib;
  85.   while TempReadSize > 0 do
  86.   begin
  87.     if TempReadSize > $8000 then
  88.     begin
  89.       BlockRead(F, TempDIB^, $8000);
  90.       if Ofs(TempDib^) = $8000 then
  91.     TempDib := Ptr(Seg(TempDib^) + 8, 0)
  92.       else
  93.     TempDib := Ptr(Seg(TempDib^), $8000);
  94.     end
  95.     else
  96.       BlockRead(F, TempDIB^, TempReadSize);
  97.     Dec(TempReadSize, $8000);
  98.   end;
  99.   if DIB^.biBitCount = 24 then
  100.     ColorTableSize := 0
  101.   else
  102.     ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);
  103.   Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);
  104.   Close(F);
  105.   DC := GetDC(Window);
  106.   DibPal := CreateBIPalette(DIB);
  107.   if DibPal = 0 then
  108.   begin
  109.     SelectPalette(DC, DibPal, false);
  110.     RealizePalette(DC);
  111.   end;
  112.   BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,
  113.     dib_RGB_Colors);
  114.   Height := DIB^.biHeight;
  115.   Width := DIB^.biWidth;
  116.   ReleaseDC(Window, DC);
  117.   GlobalUnLock(Handle);
  118.   GlobalFree(Handle);
  119.   LoadBMP := BitMap;
  120.   SetCursor(OldCursor);
  121. end;
  122.  
  123. end.
  124.